В этом отчете представлен кластерный анализ пользователей сервиса TripAdvisor и их предпочтений.
Данные об оценках пользователей были загружены и проверены с помощью следующего кода:
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
library(readr)
library(corrplot)
## corrplot 0.92 loaded
library(tidyr)
library(GGally)
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
library(plotly)
##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layout
library(stats)
library(reshape2)
##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smiths
# Загрузка данных и создание гистограмм
data <- read_csv("~/Downloads/tripadvisor_review.csv")
## Rows: 980 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): User ID
## dbl (10): Category 1, Category 2, Category 3, Category 4, Category 5, Catego...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(data)
## # A tibble: 6 × 11
## `User ID` `Category 1` `Category 2` `Category 3` `Category 4` `Category 5`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 User 1 0.93 1.8 2.29 0.62 0.8
## 2 User 2 1.02 2.2 2.66 0.64 1.42
## 3 User 3 1.22 0.8 0.54 0.53 0.24
## 4 User 4 0.45 1.8 0.29 0.57 0.46
## 5 User 5 0.51 1.2 1.18 0.57 1.54
## 6 User 6 0.99 1.28 0.72 0.27 0.74
## # ℹ 5 more variables: `Category 6` <dbl>, `Category 7` <dbl>,
## # `Category 8` <dbl>, `Category 9` <dbl>, `Category 10` <dbl>
summary(data)
## User ID Category 1 Category 2 Category 3
## Length:980 Min. :0.3400 Min. :0.000 Min. :0.130
## Class :character 1st Qu.:0.6700 1st Qu.:1.080 1st Qu.:0.270
## Mode :character Median :0.8300 Median :1.280 Median :0.820
## Mean :0.8932 Mean :1.353 Mean :1.013
## 3rd Qu.:1.0200 3rd Qu.:1.560 3rd Qu.:1.573
## Max. :3.2200 Max. :3.640 Max. :3.620
## Category 4 Category 5 Category 6 Category 7
## Min. :0.1500 Min. :0.0600 Min. :0.140 Min. :3.160
## 1st Qu.:0.4100 1st Qu.:0.6400 1st Qu.:1.460 1st Qu.:3.180
## Median :0.5000 Median :0.9000 Median :1.800 Median :3.180
## Mean :0.5325 Mean :0.9397 Mean :1.843 Mean :3.181
## 3rd Qu.:0.5800 3rd Qu.:1.2000 3rd Qu.:2.200 3rd Qu.:3.180
## Max. :3.4400 Max. :3.3000 Max. :3.760 Max. :3.210
## Category 8 Category 9 Category 10
## Min. :2.420 Min. :0.740 Min. :2.140
## 1st Qu.:2.740 1st Qu.:1.310 1st Qu.:2.540
## Median :2.820 Median :1.540 Median :2.780
## Mean :2.835 Mean :1.569 Mean :2.799
## 3rd Qu.:2.910 3rd Qu.:1.760 3rd Qu.:3.040
## Max. :3.390 Max. :3.170 Max. :3.660
Для упрощения интерпретации анализа названия столбцов были изменены в соответствии с описанием датасета:
names(data) <- c("user id", "art galleries", "dance clubs", "juice bars", "restaurants", "museums", "resorts", "parks/picnic spots", "beaches", "theatres", "religious institutions")
Был проведен корреляционный анализ и шкалирование:
#Корреляционный анализ
cor_matrix <- cor(data[,c("art galleries", "dance clubs", "juice bars", "restaurants", "museums", "resorts", "parks/picnic spots", "beaches", "theatres", "religious institutions")])
# Визуализация корреляционной матрицы
corrplot::corrplot(cor_matrix, method = "circle")
print(cor_matrix)
## art galleries dance clubs juice bars restaurants
## art galleries 1.000000000 -0.18769237 0.008612625 0.07345561
## dance clubs -0.187692365 1.00000000 0.043586045 0.13162356
## juice bars 0.008612625 0.04358605 1.000000000 0.06112782
## restaurants 0.073455614 0.13162356 0.061127822 1.00000000
## museums -0.100482517 0.11963095 0.281668111 0.10187761
## resorts 0.094141522 0.14840356 0.356434838 0.21586633
## parks/picnic spots -0.012474431 0.11005208 0.750650935 0.22834826
## beaches 0.020029399 -0.15864173 -0.172953071 -0.10358278
## theatres -0.047312854 0.07334233 -0.085435390 0.02667007
## religious institutions 0.050699941 -0.06576225 -0.440542734 -0.35290940
## museums resorts parks/picnic spots
## art galleries -0.10048252 9.414152e-02 -0.01247443
## dance clubs 0.11963095 1.484036e-01 0.11005208
## juice bars 0.28166811 3.564348e-01 0.75065094
## restaurants 0.10187761 2.158663e-01 0.22834826
## museums 1.00000000 5.813057e-01 0.23231780
## resorts 0.58130573 1.000000e+00 0.43074335
## parks/picnic spots 0.23231780 4.307434e-01 1.00000000
## beaches -0.02095721 7.057716e-05 -0.07249175
## theatres 0.04169350 9.640958e-02 0.08496488
## religious institutions -0.24746972 -4.381035e-01 -0.71073094
## beaches theatres religious institutions
## art galleries 2.002940e-02 -0.04731285 0.05069994
## dance clubs -1.586417e-01 0.07334233 -0.06576225
## juice bars -1.729531e-01 -0.08543539 -0.44054273
## restaurants -1.035828e-01 0.02667007 -0.35290940
## museums -2.095721e-02 0.04169350 -0.24746972
## resorts 7.057716e-05 0.09640958 -0.43810350
## parks/picnic spots -7.249175e-02 0.08496488 -0.71073094
## beaches 1.000000e+00 0.16969491 0.11470062
## theatres 1.696949e-01 1.00000000 -0.04568217
## religious institutions 1.147006e-01 -0.04568217 1.00000000
# Шкалирование
scaled_data <- scale(data[,c(2:6,8:10)])
scaled_data <- as.data.frame(scaled_data)
# Вычисление и анализ матрицы корреляции масштабированных данных
cor_matrix_scaled <- cor(scaled_data)
corrplot::corrplot(cor_matrix_scaled, method = "circle")
print(cor_matrix_scaled)
## art galleries dance clubs juice bars restaurants
## art galleries 1.000000000 -0.18769237 0.008612625 0.07345561
## dance clubs -0.187692365 1.00000000 0.043586045 0.13162356
## juice bars 0.008612625 0.04358605 1.000000000 0.06112782
## restaurants 0.073455614 0.13162356 0.061127822 1.00000000
## museums -0.100482517 0.11963095 0.281668111 0.10187761
## parks/picnic spots -0.012474431 0.11005208 0.750650935 0.22834826
## beaches 0.020029399 -0.15864173 -0.172953071 -0.10358278
## theatres -0.047312854 0.07334233 -0.085435390 0.02667007
## museums parks/picnic spots beaches theatres
## art galleries -0.10048252 -0.01247443 0.02002940 -0.04731285
## dance clubs 0.11963095 0.11005208 -0.15864173 0.07334233
## juice bars 0.28166811 0.75065094 -0.17295307 -0.08543539
## restaurants 0.10187761 0.22834826 -0.10358278 0.02667007
## museums 1.00000000 0.23231780 -0.02095721 0.04169350
## parks/picnic spots 0.23231780 1.00000000 -0.07249175 0.08496488
## beaches -0.02095721 -0.07249175 1.00000000 0.16969491
## theatres 0.04169350 0.08496488 0.16969491 1.00000000
Датасет был разделен на 5 кластеров:
# Использование функции kmeans для разделения данных на 5 кластеров
set.seed(42) # Устанавливаем seed для воспроизводимости k-средних
kmeans_result <- kmeans(scaled_data, centers = 5)
# Посмотрим результаты кластеризации
print(kmeans_result)
## K-means clustering with 5 clusters of sizes 21, 225, 320, 198, 216
##
## Cluster means:
## art galleries dance clubs juice bars restaurants museums
## 1 0.39371694 1.1863084 -0.5760266 5.5542240 0.2988856
## 2 0.58053472 -0.5116272 -0.4204538 -0.1018835 -0.2440549
## 3 -0.34845019 0.2383807 -0.7198135 -0.2830841 -0.6167780
## 4 -0.11296993 0.3825024 1.4796287 0.1441679 0.5273286
## 5 -0.02322344 -0.2861743 0.2040394 -0.1466354 0.6555262
## parks/picnic spots beaches theatres
## 1 0.06259814 -0.8090710 -0.16562336
## 2 -0.15406098 0.9014985 0.83294637
## 3 -0.67113686 -0.1772564 -0.22411800
## 4 1.48080438 -0.3545174 0.05500426
## 5 -0.20873293 -0.2728250 -0.56994410
##
## Clustering vector:
## [1] 4 4 3 3 5 3 3 3 3 2 2 3 4 4 4 4 3 4 3 4 5 3 3 3 2 4 4 5 3 4 4 4 4 2 2 2 3
## [38] 2 4 2 5 3 5 3 2 2 2 5 3 4 3 4 5 5 3 3 4 3 4 5 4 2 2 3 2 2 5 5 5 3 2 4 3 5
## [75] 4 4 2 4 3 3 2 3 1 5 2 3 3 3 1 3 2 3 4 4 4 2 4 5 4 2 2 2 4 3 2 4 2 3 5 4 2
## [112] 5 3 5 4 2 4 5 5 5 5 5 4 2 5 3 3 3 5 3 5 5 5 5 3 2 4 5 3 2 3 3 3 3 2 3 5 4
## [149] 2 5 5 3 3 3 3 2 2 2 4 3 5 3 3 3 5 3 4 2 4 2 2 2 3 3 2 3 2 2 3 3 2 5 5 5 4
## [186] 2 5 2 2 3 4 4 2 3 3 3 5 4 3 1 4 2 4 2 3 3 3 2 5 5 5 4 3 3 3 4 3 3 5 5 5 3
## [223] 4 3 4 3 1 5 3 4 2 4 3 3 5 3 5 3 5 2 4 4 2 3 2 3 2 1 5 3 5 3 4 4 3 2 3 1 2
## [260] 5 2 2 2 2 3 4 4 4 3 5 3 3 4 4 1 3 5 2 3 5 5 2 4 5 3 3 1 2 5 3 4 3 3 2 3 3
## [297] 3 5 2 3 3 4 4 3 2 3 2 4 2 4 3 3 5 5 5 2 4 3 4 3 2 2 2 3 3 5 4 5 3 5 2 5 2
## [334] 3 3 5 5 3 5 2 5 4 5 4 5 3 2 2 4 4 2 2 2 2 3 3 3 3 2 5 3 5 4 3 5 4 2 2 5 5
## [371] 2 4 1 4 2 4 4 3 3 3 3 3 3 3 3 4 5 5 3 3 4 3 2 3 2 4 5 5 3 2 2 4 2 3 4 5 5
## [408] 4 4 4 5 5 4 3 2 4 2 3 3 4 4 2 1 2 5 2 4 3 3 3 5 2 5 4 4 3 3 1 3 3 3 3 3 5
## [445] 5 3 3 5 5 5 2 3 2 5 2 5 3 3 4 3 2 5 5 2 2 4 3 2 5 3 4 3 3 5 5 2 5 3 4 5 5
## [482] 4 3 4 4 3 3 5 5 2 5 2 3 4 3 3 3 4 5 5 4 2 5 2 2 2 2 5 5 3 4 3 3 4 3 4 2 5
## [519] 3 2 3 4 4 3 4 4 5 2 3 3 5 2 5 5 5 5 4 4 5 2 3 3 2 5 5 3 3 2 3 3 2 4 2 2 3
## [556] 4 3 2 2 2 5 4 5 5 3 5 4 4 4 3 4 3 4 3 2 5 2 3 3 5 3 5 5 3 3 2 3 3 4 3 5 3
## [593] 1 5 2 2 3 2 4 3 3 1 4 3 2 2 5 2 3 3 5 5 2 2 2 5 3 2 2 3 3 5 4 2 3 2 4 5 3
## [630] 2 3 2 3 4 3 5 5 5 2 3 4 2 3 3 4 3 2 3 2 5 2 3 3 2 4 4 5 5 3 3 4 2 4 3 3 5
## [667] 1 5 3 3 2 4 5 3 5 3 3 2 5 3 3 2 5 2 4 4 2 3 3 5 3 3 3 3 1 5 2 3 3 3 3 4 4
## [704] 3 2 3 2 5 2 3 4 2 2 5 2 3 3 4 4 4 2 3 5 5 3 5 2 2 1 4 5 3 2 4 3 5 3 4 2 5
## [741] 5 5 2 5 3 3 2 1 3 5 4 3 4 2 5 2 2 3 3 5 5 3 5 5 5 5 3 2 2 5 5 3 2 3 2 2 2
## [778] 5 3 3 4 5 5 3 3 2 4 3 5 4 5 4 4 2 5 4 3 3 4 4 3 5 2 2 5 4 5 4 4 4 2 2 4 5
## [815] 4 2 4 3 4 4 5 2 3 5 5 3 4 3 4 1 2 2 3 3 4 4 5 1 2 5 3 3 5 3 2 4 3 3 3 3 2
## [852] 4 2 5 5 3 5 4 2 4 4 3 4 2 2 3 5 5 3 2 2 3 5 2 2 3 5 3 3 5 3 3 3 4 5 4 3 3
## [889] 4 3 5 3 4 3 3 2 2 2 5 3 2 4 2 1 5 2 3 4 2 5 2 2 2 4 5 4 4 2 3 3 4 3 2 2 4
## [926] 4 4 3 3 2 5 4 5 2 3 5 2 5 5 5 2 3 4 3 2 5 3 3 3 4 3 4 3 2 4 4 5 5 3 2 4 5
## [963] 3 4 2 2 4 3 3 3 3 2 1 3 4 3 5 5 2 5
##
## Within cluster sum of squares by cluster:
## [1] 212.0593 1438.7228 1303.2233 1005.5320 889.8242
## (between_SS / total_SS = 38.1 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
library(FactoMineR)
data(iris)
res.pca <- PCA(iris[,1:4], graph=FALSE)
# Смотрим долю объясненной вариативности
print(res.pca$eig)
## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 2.91849782 72.9624454 72.96245
## comp 2 0.91403047 22.8507618 95.81321
## comp 3 0.14675688 3.6689219 99.48213
## comp 4 0.02071484 0.5178709 100.00000
# Строим график каменистой осыпи
plot(res.pca$eig[,1], type="b", xlab="Номер компоненты", ylab="Процент объясненной вариативности",
main="График каменистой осыпи")
#график каменистой осыпи указывает на оптимальное число главных компонент для использования(3)
cluster_labels <- kmeans_result$cluster
# Выполнение PCA для сокращения данных до 3 измерений
pca_result <- prcomp(scaled_data, center = TRUE, scale. = TRUE)
principal_components <- pca_result$x[, 1:3]
# Создание нового датафрейма для визуализации
pca_df <- data.frame(principal_components)
pca_df$Cluster <- as.factor(cluster_labels) # Преобразование меток кластера в фактор для цветовой кодировки
# Преобразование фактора в числовой формат перед вычислением максимального значения
num_clusters <- as.numeric(levels(pca_df$Cluster))[pca_df$Cluster]
# Создание 3D графика с использованием plotly
fig <- plot_ly(data = pca_df, x = ~PC1, y = ~PC2, z = ~PC3, color = ~Cluster, colors = RColorBrewer::brewer.pal(max(num_clusters), "Set1"), type = "scatter3d", mode = "markers") %>%
layout(scene = list(xaxis = list(title = "PC1"),
yaxis = list(title = "PC2"),
zaxis = list(title = "PC3")),
margin = list(l = 0, r = 0, b = 0, t = 0))
# Показ графика
fig
Были вычислены средние значения для каждого кластера по всем столбцам:
# scaled_data - это масштабированный датафрейм, а cluster_labels - вектор меток кластера
# добавим к scaled_data метки кластера
scaled_data$Cluster <- cluster_labels
# Вычисление средних значений для каждого кластера по всем столбцам
library(dplyr)
cluster_means <- scaled_data %>%
group_by(Cluster) %>%
summarise_all(mean)
# Выводим результат
print(cluster_means)
## # A tibble: 5 × 9
## Cluster `art galleries` `dance clubs` `juice bars` restaurants museums
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.394 1.19 -0.576 5.55 0.299
## 2 2 0.581 -0.512 -0.420 -0.102 -0.244
## 3 3 -0.348 0.238 -0.720 -0.283 -0.617
## 4 4 -0.113 0.383 1.48 0.144 0.527
## 5 5 -0.0232 -0.286 0.204 -0.147 0.656
## # ℹ 3 more variables: `parks/picnic spots` <dbl>, beaches <dbl>, theatres <dbl>
dplyr::glimpse(cluster_means)
## Rows: 5
## Columns: 9
## $ Cluster <int> 1, 2, 3, 4, 5
## $ `art galleries` <dbl> 0.39371694, 0.58053472, -0.34845019, -0.11296993,…
## $ `dance clubs` <dbl> 1.1863084, -0.5116272, 0.2383807, 0.3825024, -0.2…
## $ `juice bars` <dbl> -0.5760266, -0.4204538, -0.7198135, 1.4796287, 0.…
## $ restaurants <dbl> 5.5542240, -0.1018835, -0.2830841, 0.1441679, -0.…
## $ museums <dbl> 0.2988856, -0.2440549, -0.6167780, 0.5273286, 0.6…
## $ `parks/picnic spots` <dbl> 0.06259814, -0.15406098, -0.67113686, 1.48080438,…
## $ beaches <dbl> -0.8090710, 0.9014985, -0.1772564, -0.3545174, -0…
## $ theatres <dbl> -0.16562336, 0.83294637, -0.22411800, 0.05500426,…
Построены boxplot’ы для визуализации средних оценок локаций в каждом кластере:
# Построение ящиков с усами
# Преобразование данных из широкого формата в длинный
df_long <- gather(scaled_data, key = "Category", value = "Score", -Cluster)
ggplot(df_long, aes(x = Cluster, y = Score, fill = factor(Cluster))) +
geom_boxplot() +
facet_wrap(~ Category, scales = "free") + # Разбивка по категориям
theme_light() +
labs(y = "Оценки", fill = "Кластер") +
scale_fill_brewer(palette = "Set3") # Использование палитры 'Set3' для цветов
Был произведен статистический вывод:
# Статистический вывод между "art galleries" и "beaches"
cor_test_art_beaches <- cor.test(scaled_data$"art galleries", scaled_data$beaches)
print("Корреляция между 'art galleries' и 'beaches':")
## [1] "Корреляция между 'art galleries' и 'beaches':"
print(cor_test_art_beaches)
##
## Pearson's product-moment correlation
##
## data: scaled_data$"art galleries" and scaled_data$beaches
## t = 0.6265, df = 978, p-value = 0.5311
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.04264684 0.08254861
## sample estimates:
## cor
## 0.0200294
# Статистический вывод между "art galleries" и "beaches" с использованием попарного t-критерия
t_test_result <- t.test(scaled_data$"art galleries", scaled_data$beaches, paired = TRUE)
# Вывод результатов теста
print(t_test_result)
##
## Paired t-test
##
## data: scaled_data$"art galleries" and scaled_data$beaches
## t = -6.8242e-13, df = 979, p-value = 1
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -0.08775944 0.08775944
## sample estimates:
## mean difference
## -3.051833e-14
Важно отметить, что обе матрицы идентичны, что указывает на то, что масштабирование данных не изменило структуру корреляций между признаками. Это ожидаемо, поскольку масштабирование изменяет масштаб данных, но не их внутренние взаимосвязи.